home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol059 / mcnemar.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-01-13  |  1.9 KB  |  38 lines
  1. 1  '                        MCNEMAR'S TEST
  2. 2  '               Copyright Tracy L. Gustafson, M.D.
  3. 3  '              Round Rock, Texas. Version 3.0, 1984
  4. 4  ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
  5. 22  DATA "MCNEMAR'S TEST (paired chi-square)",20,36
  6. 30  PRINT TAB(12);:INPUT "What is the name of the FACTOR to be tested?   ",F$
  7. 35  PRINT:PRINT "  ENTER the number of PAIRS in each category:"
  8. 40  PRINT:PRINT TAB(36);"CONTROLS"
  9. 45  PRINT TAB(28);"+ ";F$;TAB(42);"- ";F$
  10. 50  PRINT TAB(24);"VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR"
  11. 55  PRINT TAB(11);"+ ";F$;TAB(24);"CALL";TAB(39);"CALL";TAB(54);"CALL"
  12. 60  PRINT " CASES";TAB(24);"BLOADSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND<0xB4!>"
  13. 65  PRINT TAB(11);"- ";F$;TAB(24);"CALL";TAB(39);"CALL";TAB(54);"CALL"
  14. 70  PRINT TAB(24);"CLSSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND'"
  15. 75  AR=12:AC=30:GOSUB 170:BA=I:AC=46:GOSUB 170:BB=I
  16. 80  AR=14:AC=30:GOSUB 170:BC=I:AC=46:GOSUB 170:BD=I
  17. 85  X=ABS(BB-BC)-1:N=BB+BC:X=X*X/N:PRINT:PRINT
  18. 90  PRINT TAB(20);"CHI-SQUARE = ";X;TAB(53);"df = 1":PRINT
  19. 95  IF X>31 THEN P=0:GOTO 115
  20. 100  R=1.77245:S=1:I=1:K=SQR(X/2)*2/(EXP(X/2)*R):VC=3
  21. 105  I=I*X/VC:S=S+I:VC=VC+2:IF I>0 THEN 105
  22. 110  P=1-K*S
  23. 115  PLAY "MS O3 L64 G O2 GE L9 E":PRINT TAB(19);
  24. 120  COLOR CLR2,CLR1:PRINT TAB(33);"p = ";:IF P<9.99E-07 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
  25. 125  PRINT TAB(60):COLOR CLR1,CLR2:PRINT:PRINT
  26. 130  PRINT TAB(28);"ODDS RATIO = ";:IF BC=0 THEN PRINT "not calculable" ELSE PRINT BB/BC
  27. 135  XA=N*(N+3.842):XB=N*(2*BB+5.842):XD=N*(2*BB+1.842)
  28. 140  PRINT TAB(15);"95% Confidence limits:  ";
  29. 145  IF BB=0 THEN PRINT "not calculable"; ELSE PL=(XD-SQR(XD*XD-4*XA*(BB-1)*(BB-1)))/(2*XA):PRINT PL/(1-PL);
  30. 150  PRINT "  and  ";:IF BC=0 THEN PRINT "not calculable"; ELSE PU=(XB+SQR(XB*XB-4*XA*(BB+1)*(BB+1)))/(2*XA):PRINT PU/(1-PU)
  31. 155  LOCATE 25,13:INPUT;"Do you want to calculate another McNemar's test?  ",A$
  32. 160  IF A$="y" OR A$="Y" THEN 20
  33. 165  LOCATE 23,1:END
  34. 170  LOCATE AR,AC:INPUT "",I:IF INT(I)=I THEN RETURN ELSE BEEP:LOCATE 25,15:PRINT "Please enter integers only";:LOCATE AR,AC:PRINT "      ":GOTO 170
  35. 5000  BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 10,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
  36. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  37. 5010  ON ERROR GOTO 0:END
  38.